diff options
author | Alexander Foremny <aforemny@posteo.de> | 2024-02-12 10:05:02 +0100 |
---|---|---|
committer | Alexander Foremny <aforemny@posteo.de> | 2024-02-12 10:25:37 +0100 |
commit | 68566ca5a376f8508fdd1c5eff3155cde7929850 (patch) | |
tree | 3573f5b5fe392d6b46f08ef259a2be65baf77308 /app/Record.hs | |
parent | 33faca6f99dc207e81497297c205a1ff29ae2f33 (diff) |
refactor `Query`
Diffstat (limited to 'app/Record.hs')
-rw-r--r-- | app/Record.hs | 80 |
1 files changed, 0 insertions, 80 deletions
diff --git a/app/Record.hs b/app/Record.hs deleted file mode 100644 index 30e98ec..0000000 --- a/app/Record.hs +++ /dev/null @@ -1,80 +0,0 @@ -module Record - ( Record (..), - fromValue, - toValue, - lookup, - Records, - lookups, - select, - disjointUnion, - disjointUnions, - ) -where - -import Control.Exception (throw) -import Data.Aeson qualified as J -import Data.Aeson.Key qualified as JK -import Data.Aeson.KeyMap qualified as JM -import Data.List (foldl') -import Data.List.NonEmpty qualified as N -import Data.Maybe (fromMaybe, mapMaybe) -import Data.Text qualified as T -import Exception (DuplicateField (DuplicateField)) -import Field qualified as F -import Prelude hiding (lookup) - -data Record a - = Record Collection a - deriving (Show, Eq) - -type Collection = FilePath - -fromValue :: Collection -> a -> Record a -fromValue = Record - -toValue :: Record a -> a -toValue (Record _ v) = v - -lookup :: F.Field -> Record J.Value -> Maybe J.Value -lookup (F.Unqualified ks) (Record _ v) = - lookup' (N.toList ks) v -lookup (F.Qualified c' ks) (Record c v) - | c' == c = lookup' (N.toList ks) v - | otherwise = Nothing - -lookup' :: [T.Text] -> J.Value -> Maybe J.Value -lookup' [] v = Just v -lookup' (k : ks) (J.Object kvs) = - lookup' ks =<< JM.lookup (JK.fromText k) kvs - -type Records a = [Record a] - -lookups :: F.Field -> Records J.Value -> Maybe J.Value -lookups f rs = - case mapMaybe (lookup f) rs of - [] -> Nothing - [v] -> Just v - (_ : _) -> throw (DuplicateField (F.toString f)) - -select :: [F.Field] -> Records J.Value -> J.Value -select fs rs = - foldl' - union - (J.Object JM.empty) - (map (\f -> F.prefix f ((fromMaybe J.Null (lookups f rs)))) fs) - -union :: J.Value -> J.Value -> J.Value -union (J.Object r) (J.Object s) = J.Object (JM.unionWith union r s) - -disjointUnion :: J.Value -> J.Value -> J.Value -disjointUnion (J.Object r) (J.Object s) = - J.Object (JM.unionWithKey disjointUnion' r s) - -disjointUnion' :: JK.Key -> J.Value -> J.Value -> J.Value -disjointUnion' _ (J.Object r) (J.Object s) = - J.Object (JM.unionWithKey disjointUnion' r s) -disjointUnion' k _ _ = - throw (DuplicateField (JK.toString k)) - -disjointUnions :: [J.Value] -> J.Value -disjointUnions = foldl' disjointUnion (J.Object JM.empty) |