src/Data/Gargantext/Utils/Prefix.hs

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