src/Gargantext/Utils/Prefix.hs

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