src/Gargantext/Utils/Prefix.hs

   1 {-|
   2 Module      : Gargantext.Utils.Prefix
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Here is a longer description of this module, containing some
  11 commentary with @some markup@.
  12 -}
  13
  14 {-# LANGUAGE NoImplicitPrelude #-}
  15
  16 module Gargantext.Utils.Prefix where
  17
  18 import Prelude
  19
  20 import Data.Aeson (Value, defaultOptions, parseJSON)
  21 import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields)
  22 import Data.Aeson.Types (Parser)
  23 import Data.Char (toLower)
  24 import Data.Monoid ((<>))
  25 import Text.Read (Read(..),readMaybe)
  26
  27
  28 -- | Aeson Options that remove the prefix from fields
  29 unPrefix :: String -> Options
  30 unPrefix prefix = defaultOptions
  31   { fieldLabelModifier = unCapitalize . dropPrefix prefix
  32   , omitNothingFields = True
  33   }
  34
  35 -- | Lower case leading character
  36 unCapitalize :: String -> String
  37 unCapitalize [] = []
  38 unCapitalize (c:cs) = toLower c : cs
  39 --unCapitalize cs = map toLower cs
  40
  41 -- | Remove given prefix
  42 dropPrefix :: String -> String -> String
  43 dropPrefix prefix input = go prefix input
  44   where
  45     go pre [] = error $ conStringual $ "prefix leftover: " <> pre
  46     go [] (c:cs) = c : cs
  47     go (p:preRest) (c:cRest)
  48       | p == c = go preRest cRest
  49       | otherwise = error $ conStringual $ "not equal: " <>  (p:preRest)  <> " " <> (c:cRest)
  50
  51     conStringual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
  52
  53 parseJSONFromString :: (Read a) => Value -> Parser a
  54 parseJSONFromString v = do
  55   numString <- parseJSON v
  56   case readMaybe (numString :: String) of
  57     Nothing -> fail $ "Invalid number for TransactionID: " ++ show v
  58     Just n -> return n