module System.Directory.Layout.Internal
( DL(..), Layout
) where
import Control.Applicative (Applicative(..), (<$>))
import Data.Foldable (Foldable(..))
import Data.Traversable (Traversable(..), fmapDefault, foldMapDefault)
import Data.Monoid (Monoid(..))
import Data.Default (Default(..))
import Data.Functor.Apply (Apply(..))
import Data.Functor.Bind (Bind(..))
import Data.Semigroup (Semigroup(..))
import Data.Text (Text)
type Layout = DL ()
data DL a
= E !a
| T !Text !a
| F !FilePath !Layout !(DL a)
| D !FilePath !Layout !(DL a)
deriving (Show, Read, Eq, Ord)
instance Default a => Default (DL a) where
def = E def
instance Semigroup (DL a) where
E _ <> b = b
T _ _ <> b = b
F f t l <> b = F f t (l <> b)
D f l l' <> b = D f l (l' <> b)
instance Default a => Monoid (DL a) where
mempty = def
mappend = (<>)
instance Functor DL where
fmap = fmapDefault
instance Apply DL where
E f <.> E x = E (f x)
E f <.> T t x = T t (f x)
T t f <.> E x = T t (f x)
T t f <.> T _ x = T t (f x)
f <.> F fp c x = F fp c (f <.> x)
f <.> D fp l x = D fp l (f <.> x)
F fp c f <.> x = F fp c (f <.> x)
D fp l f <.> x = D fp l (f <.> x)
instance Applicative DL where
pure = E
(<*>) = (<.>)
instance Bind DL where
E x >>- f = f x
T _ x >>- f = f x
F fp c x >>- f = F fp c (x >>- f)
D fp x y >>- f = D fp x (y >>- f)
instance Monad DL where
return = pure
(>>=) = (>>-)
instance Foldable DL where
foldMap = foldMapDefault
instance Traversable DL where
traverse f (E x) = E <$> f x
traverse f (T t x) = T t <$> f x
traverse f (F fp t x) = F fp t <$> traverse f x
traverse f (D fp x y) = D fp x <$> traverse f y