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
  26 -- | Remove given prefix
  27 dropPrefix :: String -> String -> String
  28 dropPrefix prefix input = go prefix input
  29   where
  30     go pre [] = error $ conStringual $ "prefix leftover: " <> pre
  31     go [] (c:cs) = c : cs
  32     go (p:preRest) (c:cRest)
  33       | p == c = go preRest cRest
  34       | otherwise = error $ conStringual $ "not equal: " <>  (p:preRest)  <> " " <> (c:cRest)
  35
  36     conStringual msg = "dropPrefix: " <> msg <> ". " <> prefix <> " " <> input
  37
  38 parseJSONFromString :: (Read a) => Value -> Parser a
  39 parseJSONFromString v = do
  40   numString <- parseJSON v
  41   case readMaybe (numString :: String) of
  42     Nothing -> fail $ "Invalid number for TransactionID: " ++ show v
  43     Just n -> return n