module System.Directory.Layout.Parser
( layout, layout'
) where
import Control.Applicative
import Control.Arrow (left)
import Control.Monad (guard)
import Data.Functor.Identity (Identity)
import Data.List (intercalate)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Text.Parsec hiding ((<|>), many)
import Text.Parsec.Text ()
import Text.Parsec.Text.Lazy ()
import System.Directory.Layout.Internal
layout ∷ LT.Text → Either String Layout
layout = glayout
layout' ∷ T.Text → Either String Layout
layout' = glayout
glayout ∷ Stream s Identity Char ⇒ s → Either String Layout
glayout = left show . parse (sequence_ <$> many (p_any 0)) "(layout parser)"
p_any ∷ Stream s Identity Char ⇒ Int → Parsec s u Layout
p_any n = try (p_directory n) <|> p_file n
p_directory ∷ Stream s Identity Char ⇒ Int → Parsec s u Layout
p_directory n = do
name ← p_directory_name
inner ← sequence_ <$> try (inners p_any n) <|> return (E ())
return $ D name inner (E ())
p_file ∷ Stream s Identity Char ⇒ Int → Parsec s u Layout
p_file n = do
name ← p_file_name
inner ← Just . T.intercalate "\n" <$> try (inners (const p_text) n) <|> return Nothing
return $ F name inner (E ())
inners ∷ Stream s Identity Char ⇒ (Int → Parsec s u a) → Int → Parsec s u [a]
inners p n = do
indent ← length <$> many (char ' ')
guard (indent > n)
(:) <$> p indent <*> generous_many (string (replicate indent ' ') *> p indent)
generous_many ∷ Parsec s u a → Parsec s u [a]
generous_many p = f
where
f = try ((:) <$> p <*> f) <|> return []
p_directory_name ∷ Stream s Identity Char ⇒ Parsec s u String
p_directory_name = some (noneOf "/\n") <* char '/' <* char '\n'
p_file_name ∷ Stream s Identity Char ⇒ Parsec s u String
p_file_name = intercalate "." <$> ((some (noneOf "/.\n") `sepBy` char '.') <* char '\n')
p_text ∷ Stream s Identity Char ⇒ Parsec s u T.Text
p_text = T.pack <$> many (noneOf "\n") <* char '\n'