src/Gargantext/Utils/Prefix.hs

   1
   2 module Gargantext.Utils.Prefix where
   3
   4 import Prelude
   5
   6 import Data.Aeson (Value, defaultOptions, parseJSON)
   7 import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields)
   8 import Data.Aeson.Types (Parser)
   9 import Data.Char (toLower)
  10 import Data.Monoid ((<>))
  11 import Text.Read (Read(..),readMaybe)
  12
  13
  14 -- | Aeson Options that remove the prefix from fields
  15 unPrefix :: String -> Options
  16 unPrefix prefix = defaultOptions
  17   { fieldLabelModifier = unCapitalize . dropPrefix prefix
  18   , omitNothingFields = True
  19   }
  20
  21 -- | Lower case leading character
  22 unCapitalize :: String -> String
  23 unCapitalize [] = []
  24 unCapitalize (c:cs) = toLower c : cs
  25 --unCapitalize cs = map toLower cs
  26
  27 -- | Remove given prefix
  28 dropPrefix :: String -> String -> String
  29 dropPrefix prefix input = go prefix input
  30   where
  31     go pre [] = error $ conStringual $ "prefix leftover: " <> pre
  32     go [] (c:cs) = c : cs
  33     go (p:preRest) (c:cRest)
  34       | p == c = go preRest cRest
  35       | otherwise = error $ conStringual $ "not equal: " <>  (p:preRest)  <> " " <> (c:cRest)
  36
  37     conStringual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
  38
  39 parseJSONFromString :: (Read a) => Value -> Parser a
  40 parseJSONFromString v = do
  41   numString <- parseJSON v
  42   case readMaybe (numString :: String) of
  43     Nothing -> fail $ "Invalid number for TransactionID: " ++ show v
  44     Just n -> return n