{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}

module Data.TagTree
  ( -- * Types
    Tag (..),
    TagPattern (unTagPattern),
    TagNode (..),

    -- * Create Tags
    constructTag,
    deconstructTag,

    -- * Creating Tag Trees
    tagTree,

    -- * Searching Tags
    mkTagPattern,
    mkTagPatternFromTag,
    tagMatch,

    -- * Working with Tag Trees
    foldTagTree,
  )
where

import Control.Monad.Combinators.NonEmpty (sepBy1)
import Data.Aeson (FromJSON, ToJSON, ToJSONKey)
import Data.Default (Default (def))
import qualified Data.Map.Strict as Map
import Data.TagTree.PathTree (annotatePathsWith, foldSingleParentsWith, mkTreeFromPaths)
import qualified Data.Text as T
import Data.Tree (Forest)
import System.FilePattern (FilePattern, (?==))
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as M

-- | A hierarchical tag
--
-- Tag nodes are separated by @/@
newtype Tag = Tag {Tag -> Text
unTag :: Text}
  deriving (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Eq Tag
Eq Tag
-> (Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
$cp1Ord :: Eq Tag
Ord, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, (forall x. Tag -> Rep Tag x)
-> (forall x. Rep Tag x -> Tag) -> Generic Tag
forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tag x -> Tag
$cfrom :: forall x. Tag -> Rep Tag x
Generic)
  deriving newtype
    ( [Tag] -> Encoding
[Tag] -> Value
Tag -> Encoding
Tag -> Value
(Tag -> Value)
-> (Tag -> Encoding)
-> ([Tag] -> Value)
-> ([Tag] -> Encoding)
-> ToJSON Tag
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Tag] -> Encoding
$ctoEncodingList :: [Tag] -> Encoding
toJSONList :: [Tag] -> Value
$ctoJSONList :: [Tag] -> Value
toEncoding :: Tag -> Encoding
$ctoEncoding :: Tag -> Encoding
toJSON :: Tag -> Value
$ctoJSON :: Tag -> Value
ToJSON,
      Value -> Parser [Tag]
Value -> Parser Tag
(Value -> Parser Tag) -> (Value -> Parser [Tag]) -> FromJSON Tag
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Tag]
$cparseJSONList :: Value -> Parser [Tag]
parseJSON :: Value -> Parser Tag
$cparseJSON :: Value -> Parser Tag
FromJSON,
      ToJSONKeyFunction [Tag]
ToJSONKeyFunction Tag
ToJSONKeyFunction Tag -> ToJSONKeyFunction [Tag] -> ToJSONKey Tag
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [Tag]
$ctoJSONKeyList :: ToJSONKeyFunction [Tag]
toJSONKey :: ToJSONKeyFunction Tag
$ctoJSONKey :: ToJSONKeyFunction Tag
ToJSONKey
    )

--------------
-- Tag Pattern
---------------

-- | A glob-based pattern to match hierarchical tags
--
-- For example, the pattern
--
-- > foo/**
--
-- matches both the following
--
-- > foo/bar/baz
-- > foo/baz
newtype TagPattern = TagPattern {TagPattern -> String
unTagPattern :: FilePattern}
  deriving
    ( TagPattern -> TagPattern -> Bool
(TagPattern -> TagPattern -> Bool)
-> (TagPattern -> TagPattern -> Bool) -> Eq TagPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagPattern -> TagPattern -> Bool
$c/= :: TagPattern -> TagPattern -> Bool
== :: TagPattern -> TagPattern -> Bool
$c== :: TagPattern -> TagPattern -> Bool
Eq,
      Eq TagPattern
Eq TagPattern
-> (TagPattern -> TagPattern -> Ordering)
-> (TagPattern -> TagPattern -> Bool)
-> (TagPattern -> TagPattern -> Bool)
-> (TagPattern -> TagPattern -> Bool)
-> (TagPattern -> TagPattern -> Bool)
-> (TagPattern -> TagPattern -> TagPattern)
-> (TagPattern -> TagPattern -> TagPattern)
-> Ord TagPattern
TagPattern -> TagPattern -> Bool
TagPattern -> TagPattern -> Ordering
TagPattern -> TagPattern -> TagPattern
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagPattern -> TagPattern -> TagPattern
$cmin :: TagPattern -> TagPattern -> TagPattern
max :: TagPattern -> TagPattern -> TagPattern
$cmax :: TagPattern -> TagPattern -> TagPattern
>= :: TagPattern -> TagPattern -> Bool
$c>= :: TagPattern -> TagPattern -> Bool
> :: TagPattern -> TagPattern -> Bool
$c> :: TagPattern -> TagPattern -> Bool
<= :: TagPattern -> TagPattern -> Bool
$c<= :: TagPattern -> TagPattern -> Bool
< :: TagPattern -> TagPattern -> Bool
$c< :: TagPattern -> TagPattern -> Bool
compare :: TagPattern -> TagPattern -> Ordering
$ccompare :: TagPattern -> TagPattern -> Ordering
$cp1Ord :: Eq TagPattern
Ord,
      Int -> TagPattern -> ShowS
[TagPattern] -> ShowS
TagPattern -> String
(Int -> TagPattern -> ShowS)
-> (TagPattern -> String)
-> ([TagPattern] -> ShowS)
-> Show TagPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagPattern] -> ShowS
$cshowList :: [TagPattern] -> ShowS
show :: TagPattern -> String
$cshow :: TagPattern -> String
showsPrec :: Int -> TagPattern -> ShowS
$cshowsPrec :: Int -> TagPattern -> ShowS
Show,
      (forall x. TagPattern -> Rep TagPattern x)
-> (forall x. Rep TagPattern x -> TagPattern) -> Generic TagPattern
forall x. Rep TagPattern x -> TagPattern
forall x. TagPattern -> Rep TagPattern x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagPattern x -> TagPattern
$cfrom :: forall x. TagPattern -> Rep TagPattern x
Generic
    )
  deriving newtype
    ( [TagPattern] -> Encoding
[TagPattern] -> Value
TagPattern -> Encoding
TagPattern -> Value
(TagPattern -> Value)
-> (TagPattern -> Encoding)
-> ([TagPattern] -> Value)
-> ([TagPattern] -> Encoding)
-> ToJSON TagPattern
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TagPattern] -> Encoding
$ctoEncodingList :: [TagPattern] -> Encoding
toJSONList :: [TagPattern] -> Value
$ctoJSONList :: [TagPattern] -> Value
toEncoding :: TagPattern -> Encoding
$ctoEncoding :: TagPattern -> Encoding
toJSON :: TagPattern -> Value
$ctoJSON :: TagPattern -> Value
ToJSON,
      Value -> Parser [TagPattern]
Value -> Parser TagPattern
(Value -> Parser TagPattern)
-> (Value -> Parser [TagPattern]) -> FromJSON TagPattern
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TagPattern]
$cparseJSONList :: Value -> Parser [TagPattern]
parseJSON :: Value -> Parser TagPattern
$cparseJSON :: Value -> Parser TagPattern
FromJSON
    )

mkTagPattern :: Text -> TagPattern
mkTagPattern :: Text -> TagPattern
mkTagPattern =
  String -> TagPattern
TagPattern (String -> TagPattern) -> (Text -> String) -> Text -> TagPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString

mkTagPatternFromTag :: Tag -> TagPattern
mkTagPatternFromTag :: Tag -> TagPattern
mkTagPatternFromTag (Tag Text
t) =
  String -> TagPattern
TagPattern (String -> TagPattern) -> String -> TagPattern
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
t

tagMatch :: TagPattern -> Tag -> Bool
tagMatch :: TagPattern -> Tag -> Bool
tagMatch (TagPattern String
pat) (Tag Text
tag) =
  String
pat String -> String -> Bool
?== Text -> String
forall a. ToString a => a -> String
toString Text
tag

-----------
-- Tag Tree
-----------

-- | An individual component of a hierarchical tag
--
-- The following hierarchical tag,
--
-- > foo/bar/baz
--
-- has three tag nodes: @foo@, @bar@ and @baz@
newtype TagNode = TagNode {TagNode -> Text
unTagNode :: Text}
  deriving (TagNode -> TagNode -> Bool
(TagNode -> TagNode -> Bool)
-> (TagNode -> TagNode -> Bool) -> Eq TagNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagNode -> TagNode -> Bool
$c/= :: TagNode -> TagNode -> Bool
== :: TagNode -> TagNode -> Bool
$c== :: TagNode -> TagNode -> Bool
Eq, Int -> TagNode -> ShowS
[TagNode] -> ShowS
TagNode -> String
(Int -> TagNode -> ShowS)
-> (TagNode -> String) -> ([TagNode] -> ShowS) -> Show TagNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagNode] -> ShowS
$cshowList :: [TagNode] -> ShowS
show :: TagNode -> String
$cshow :: TagNode -> String
showsPrec :: Int -> TagNode -> ShowS
$cshowsPrec :: Int -> TagNode -> ShowS
Show, Eq TagNode
Eq TagNode
-> (TagNode -> TagNode -> Ordering)
-> (TagNode -> TagNode -> Bool)
-> (TagNode -> TagNode -> Bool)
-> (TagNode -> TagNode -> Bool)
-> (TagNode -> TagNode -> Bool)
-> (TagNode -> TagNode -> TagNode)
-> (TagNode -> TagNode -> TagNode)
-> Ord TagNode
TagNode -> TagNode -> Bool
TagNode -> TagNode -> Ordering
TagNode -> TagNode -> TagNode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagNode -> TagNode -> TagNode
$cmin :: TagNode -> TagNode -> TagNode
max :: TagNode -> TagNode -> TagNode
$cmax :: TagNode -> TagNode -> TagNode
>= :: TagNode -> TagNode -> Bool
$c>= :: TagNode -> TagNode -> Bool
> :: TagNode -> TagNode -> Bool
$c> :: TagNode -> TagNode -> Bool
<= :: TagNode -> TagNode -> Bool
$c<= :: TagNode -> TagNode -> Bool
< :: TagNode -> TagNode -> Bool
$c< :: TagNode -> TagNode -> Bool
compare :: TagNode -> TagNode -> Ordering
$ccompare :: TagNode -> TagNode -> Ordering
$cp1Ord :: Eq TagNode
Ord, (forall x. TagNode -> Rep TagNode x)
-> (forall x. Rep TagNode x -> TagNode) -> Generic TagNode
forall x. Rep TagNode x -> TagNode
forall x. TagNode -> Rep TagNode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagNode x -> TagNode
$cfrom :: forall x. TagNode -> Rep TagNode x
Generic)
  deriving newtype ([TagNode] -> Encoding
[TagNode] -> Value
TagNode -> Encoding
TagNode -> Value
(TagNode -> Value)
-> (TagNode -> Encoding)
-> ([TagNode] -> Value)
-> ([TagNode] -> Encoding)
-> ToJSON TagNode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TagNode] -> Encoding
$ctoEncodingList :: [TagNode] -> Encoding
toJSONList :: [TagNode] -> Value
$ctoJSONList :: [TagNode] -> Value
toEncoding :: TagNode -> Encoding
$ctoEncoding :: TagNode -> Encoding
toJSON :: TagNode -> Value
$ctoJSON :: TagNode -> Value
ToJSON)

deconstructTag :: HasCallStack => Tag -> NonEmpty TagNode
deconstructTag :: Tag -> NonEmpty TagNode
deconstructTag (Tag Text
s) =
  (Text -> NonEmpty TagNode)
-> (NonEmpty TagNode -> NonEmpty TagNode)
-> Either Text (NonEmpty TagNode)
-> NonEmpty TagNode
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> NonEmpty TagNode
forall a t. (HasCallStack, IsText t) => t -> a
error NonEmpty TagNode -> NonEmpty TagNode
forall a. a -> a
id (Either Text (NonEmpty TagNode) -> NonEmpty TagNode)
-> Either Text (NonEmpty TagNode) -> NonEmpty TagNode
forall a b. (a -> b) -> a -> b
$ Parser (NonEmpty TagNode)
-> String -> Text -> Either Text (NonEmpty TagNode)
forall a. Parser a -> String -> Text -> Either Text a
parse Parser (NonEmpty TagNode)
tagParser (Text -> String
forall a. ToString a => a -> String
toString Text
s) Text
s
  where
    tagParser :: Parser (NonEmpty TagNode)
    tagParser :: Parser (NonEmpty TagNode)
tagParser =
      Parser TagNode
nodeParser Parser TagNode
-> ParsecT Void Text Identity Char -> Parser (NonEmpty TagNode)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
`sepBy1` Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
M.char Char
Token Text
'/'
    nodeParser :: Parser TagNode
    nodeParser :: Parser TagNode
nodeParser =
      Text -> TagNode
TagNode (Text -> TagNode) -> (String -> Text) -> String -> TagNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> TagNode)
-> ParsecT Void Text Identity String -> Parser TagNode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.anySingleBut Char
Token Text
'/')

constructTag :: NonEmpty TagNode -> Tag
constructTag :: NonEmpty TagNode -> Tag
constructTag ((TagNode -> Text) -> [TagNode] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TagNode -> Text
unTagNode ([TagNode] -> [Text])
-> (NonEmpty TagNode -> [TagNode]) -> NonEmpty TagNode -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty TagNode -> [TagNode]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [Text]
nodes) =
  Text -> Tag
Tag (Text -> Tag) -> Text -> Tag
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
nodes

-- | Construct the tree from a list of hierarchical tags
tagTree :: (Eq a, Default a) => Map Tag a -> Forest (TagNode, a)
tagTree :: Map Tag a -> Forest (TagNode, a)
tagTree Map Tag a
tags =
  (Tree TagNode -> Tree (TagNode, a))
-> [Tree TagNode] -> Forest (TagNode, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NonEmpty TagNode -> a) -> Tree TagNode -> Tree (TagNode, a)
forall a ann. (NonEmpty a -> ann) -> Tree a -> Tree (a, ann)
annotatePathsWith ((NonEmpty TagNode -> a) -> Tree TagNode -> Tree (TagNode, a))
-> (NonEmpty TagNode -> a) -> Tree TagNode -> Tree (TagNode, a)
forall a b. (a -> b) -> a -> b
$ Map Tag a -> NonEmpty TagNode -> a
forall a. Default a => Map Tag a -> NonEmpty TagNode -> a
countFor Map Tag a
tags) ([Tree TagNode] -> Forest (TagNode, a))
-> [Tree TagNode] -> Forest (TagNode, a)
forall a b. (a -> b) -> a -> b
$
    [[TagNode]] -> [Tree TagNode]
forall a. Ord a => [[a]] -> Forest a
mkTreeFromPaths ([[TagNode]] -> [Tree TagNode]) -> [[TagNode]] -> [Tree TagNode]
forall a b. (a -> b) -> a -> b
$
      NonEmpty TagNode -> [TagNode]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty TagNode -> [TagNode])
-> (Tag -> NonEmpty TagNode) -> Tag -> [TagNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Tag -> NonEmpty TagNode
Tag -> NonEmpty TagNode
deconstructTag
        (Tag -> [TagNode]) -> [Tag] -> [[TagNode]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Tag a -> [Tag]
forall k a. Map k a -> [k]
Map.keys Map Tag a
tags
  where
    countFor :: Map Tag a -> NonEmpty TagNode -> a
countFor Map Tag a
tags' NonEmpty TagNode
path =
      a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Default a => a
def (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Tag -> Map Tag a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (NonEmpty TagNode -> Tag
constructTag NonEmpty TagNode
path) Map Tag a
tags'

foldTagTree :: (Eq a, Default a) => Forest (TagNode, a) -> Forest (NonEmpty TagNode, a)
foldTagTree :: Forest (TagNode, a) -> Forest (NonEmpty TagNode, a)
foldTagTree Forest (TagNode, a)
tree =
  ((NonEmpty TagNode, a)
 -> (NonEmpty TagNode, a) -> Maybe (NonEmpty TagNode, a))
-> Tree (NonEmpty TagNode, a) -> Tree (NonEmpty TagNode, a)
forall a. (a -> a -> Maybe a) -> Tree a -> Tree a
foldSingleParentsWith (NonEmpty TagNode, a)
-> (NonEmpty TagNode, a) -> Maybe (NonEmpty TagNode, a)
forall a a b.
(Eq a, Default a, Semigroup a) =>
(a, a) -> (a, b) -> Maybe (a, b)
foldNodes (Tree (NonEmpty TagNode, a) -> Tree (NonEmpty TagNode, a))
-> Forest (NonEmpty TagNode, a) -> Forest (NonEmpty TagNode, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree (TagNode, a) -> Tree (NonEmpty TagNode, a))
-> Forest (TagNode, a) -> Forest (NonEmpty TagNode, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((TagNode, a) -> (NonEmpty TagNode, a))
-> Tree (TagNode, a) -> Tree (NonEmpty TagNode, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TagNode -> NonEmpty TagNode)
-> (TagNode, a) -> (NonEmpty TagNode, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (TagNode -> [TagNode] -> NonEmpty TagNode
forall a. a -> [a] -> NonEmpty a
:| []))) Forest (TagNode, a)
tree
  where
    foldNodes :: (a, a) -> (a, b) -> Maybe (a, b)
foldNodes (a
parent, a
x) (a
child, b
y) = do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Default a => a
def)
      (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
parent a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
child, b
y)

type Parser a = M.Parsec Void Text a

parse :: Parser a -> String -> Text -> Either Text a
parse :: Parser a -> String -> Text -> Either Text a
parse Parser a
p String
fn Text
s =
  (ParseErrorBundle Text Void -> Text)
-> Either (ParseErrorBundle Text Void) a -> Either Text a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
M.errorBundlePretty) (Either (ParseErrorBundle Text Void) a -> Either Text a)
-> Either (ParseErrorBundle Text Void) a -> Either Text a
forall a b. (a -> b) -> a -> b
$
    Parser a -> String -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
M.parse (Parser a
p Parser a -> ParsecT Void Text Identity () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
M.eof) String
fn Text
s