]> Git — Sourcephile - gargantext.git/blob - src/Data/Gargantext/Utils/Prefix.hs
[FIX] Tree type and errors message in Date parsing.
[gargantext.git] / src / Data / Gargantext / Utils / Prefix.hs
1 module Data.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