{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RebindableSyntax #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | Helpers for converting between lhs and hs files.
--
module Readme.Convert
  ( Section (..),
    Block (..),
    Format (..),
    bird,
    normal,
    parseHs,
    printHs,
    parseLhs,
    printLhs,
    parse,
    print,
    lhs2hs,
    hs2lhs
  )
where

import qualified Control.Foldl as L
import qualified Data.Attoparsec.Text as A
import qualified Data.List as List
import NumHask.Prelude hiding (print)

-- | Type of file section
data Section = Code | Comment deriving (Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> ShowS
$cshowsPrec :: Int -> Section -> ShowS
Show, Section -> Section -> Bool
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq)

-- | A native section block.
data Block = Block Section [Text] deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq)

-- | *.lhs bird style
bird :: A.Parser Block
bird :: Parser Block
bird =
  (\Text
x -> Section -> [Text] -> Block
Block Section
Code [Text
x]) (Text -> Block) -> Parser Text Text -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
"> " Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
A.takeText)
    Parser Block -> Parser Block -> Parser Block
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Text
_ -> Section -> [Text] -> Block
Block Section
Code [Text
""]) (Text -> Block) -> Parser Text Text -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
">" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
A.takeText)
    Parser Block -> Parser Block -> Parser Block
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Text
x -> Section -> [Text] -> Block
Block Section
Comment [Text
x]) (Text -> Block) -> Parser Text Text -> Parser Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
A.takeText

-- | Parse an lhs-style block of text in
parseLhs :: [Text] -> [Block]
parseLhs :: [Text] -> [Block]
parseLhs [Text]
text = Fold (Either String Block) [Block]
-> [Either String Block] -> [Block]
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((Block, [Block]) -> Either String Block -> (Block, [Block]))
-> (Block, [Block])
-> ((Block, [Block]) -> [Block])
-> Fold (Either String Block) [Block]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (Block, [Block]) -> Either String Block -> (Block, [Block])
forall a. (Block, [Block]) -> Either a Block -> (Block, [Block])
step (Block, [Block])
forall a. (Block, [a])
begin (Block, [Block]) -> [Block]
done) ([Either String Block] -> [Block])
-> [Either String Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ Parser Block -> Text -> Either String Block
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser Block
bird (Text -> Either String Block) -> [Text] -> [Either String Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
text
  where
    begin :: (Block, [a])
begin = (Section -> [Text] -> Block
Block Section
Code [], [])
    done :: (Block, [Block]) -> [Block]
done (Block Section
_ [], [Block]
out) = [Block] -> [Block]
forall (f :: * -> *). Functor f => f Block -> f Block
unlit' [Block]
out
    done (Block
block, [Block]
out) = [Block] -> [Block]
forall (f :: * -> *). Functor f => f Block -> f Block
unlit' ([Block] -> [Block]) -> [Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Block]
out [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<> [Block
block]
    unlit' :: f Block -> f Block
unlit' f Block
ss =
      ( \(Block Section
s [Text]
ts) ->
          case Section
s of
            Section
Comment -> Section -> [Text] -> Block
Block Section
s ([Text] -> [Text]
forall a. (IsString a, Eq a) => [a] -> [a]
unlit [Text]
ts)
            Section
Code -> Section -> [Text] -> Block
Block Section
s [Text]
ts
      )
        (Block -> Block) -> f Block -> f Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Block
ss
    step :: (Block, [Block]) -> Either a Block -> (Block, [Block])
step (Block, [Block])
x (Left a
_) = (Block, [Block])
x
    step (Block Section
s [Text]
ts, [Block]
out) (Right (Block Section
s' [Text]
ts')) =
      if
        | Section
s Section -> Section -> Bool
forall a. Eq a => a -> a -> Bool
== Section
s' -> (Section -> [Text] -> Block
Block Section
s ([Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts'), [Block]
out)
        | Bool
otherwise -> case [Text]
ts of
          [] -> (Section -> [Text] -> Block
Block Section
s' [Text]
ts, [Block]
out)
          [Text]
_ -> (Section -> [Text] -> Block
Block Section
s' [Text]
ts', [Block]
out [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<> [Section -> [Text] -> Block
Block Section
s [Text]
ts])
    unlit :: [a] -> [a]
unlit [] = [a
""]
    unlit [a
""] = [a
""]
    unlit [a]
xs =
      if
        | ([a] -> Maybe a
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [a]
xs Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
"") Bool -> Bool -> Bool
&& ([a] -> Maybe a
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs) Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
"") ->
          [a] -> [a]
forall a. [a] -> [a]
List.init ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
List.tail [a]
xs
        | ([a] -> Maybe a
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [a]
xs Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
"") ->
          [a] -> [a]
forall a. [a] -> [a]
List.tail [a]
xs
        | ([a] -> Maybe a
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs) Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
"") ->
          [a] -> [a]
forall a. [a] -> [a]
List.init [a]
xs
        | Bool
otherwise ->
          [a]
xs

-- | Convert a block of code into lhs.
printLhs :: [Block] -> [Text]
printLhs :: [Block] -> [Text]
printLhs [Block]
ss =
  [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$
    ( \(Block Section
s [Text]
ts) ->
        case Section
s of
          Section
Code -> (Text
"> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts
          Section
Comment -> [Text] -> [Text]
forall a. (IsString a, Eq a) => [a] -> [a]
lit [Text]
ts
    )
      (Block -> [Text]) -> [Block] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block]
ss
  where
    lit :: [a] -> [a]
lit [] = [a
""]
    lit [a
""] = [a
""]
    lit [a]
xs =
      [a] -> [a] -> Bool -> [a]
forall a. a -> a -> Bool -> a
bool [a
""] [] ([a] -> Maybe a
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [a]
xs Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Maybe a
forall a. a -> Maybe a
Just a
"")
        [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
xs
        [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a] -> [a] -> Bool -> [a]
forall a. a -> a -> Bool -> a
bool [a
""] [] ([a] -> a
forall a. [a] -> a
List.last [a]
xs a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"")

-- | Parse a .hs
--
-- Normal code (.hs) is parsed where lines that are continuation of a section (neither contain clues as to whether code or comment) are output as Nothing, and the clues as to what the current and next section are is encoded as Just (current, next).
normal :: A.Parser (Maybe (Section, Section), [Text])
normal :: Parser (Maybe (Section, Section), [Text])
normal =
  -- Nothing represents a continuation of previous section
  (Maybe (Section, Section)
forall a. Maybe a
Nothing, [Text
""]) (Maybe (Section, Section), [Text])
-> Parser Text () -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- exact matches include line removal
    ((Section, Section) -> Maybe (Section, Section)
forall a. a -> Maybe a
Just (Section
Comment, Section
Comment), []) (Maybe (Section, Section), [Text])
-> Parser Text () -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Parser Text Text
"{-" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput)
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Section, Section) -> Maybe (Section, Section)
forall a. a -> Maybe a
Just (Section
Comment, Section
Code), []) (Maybe (Section, Section), [Text])
-> Parser Text () -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Parser Text Text
"-}" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput)
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- single line braced
    (\Text
x -> ((Section, Section) -> Maybe (Section, Section)
forall a. a -> Maybe a
Just (Section
Code, Section
Code), [Text
"{-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-}"]))
      (Text -> (Maybe (Section, Section), [Text]))
-> Parser Text Text -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
"{-" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Text
pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text Text -> Parser Text String
forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
A.manyTill' Parser Text Char
A.anyChar Parser Text Text
"-}"))
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- pragmas
    (\Text
x -> ((Section, Section) -> Maybe (Section, Section)
forall a. a -> Maybe a
Just (Section
Code, Section
Code), [Text
"{-#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x])) (Text -> (Maybe (Section, Section), [Text]))
-> Parser Text Text -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
"{-#" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
A.takeText)
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Text
x -> ((Section, Section) -> Maybe (Section, Section)
forall a. a -> Maybe a
Just (Section
Code, Section
Code), [Text
x])) (Text -> (Maybe (Section, Section), [Text]))
-> Parser Text Text -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text Text -> Parser Text String
forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
A.manyTill' Parser Text Char
A.anyChar Parser Text Text
"#-}")
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- braced start of multi-line comment (brace is stripped)
    (\Text
x -> ((Section, Section) -> Maybe (Section, Section)
forall a. a -> Maybe a
Just (Section
Comment, Section
Comment), [Text
x])) (Text -> (Maybe (Section, Section), [Text]))
-> Parser Text Text -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
"{-" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
A.takeText)
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- braced end of multi-line comment (brace is stripped)
    (\Text
x -> ((Section, Section) -> Maybe (Section, Section)
forall a. a -> Maybe a
Just (Section
Comment, Section
Code), [Text
x])) (Text -> (Maybe (Section, Section), [Text]))
-> Parser Text Text -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text Text -> Parser Text String
forall (m :: * -> *) a b. MonadPlus m => m a -> m b -> m [a]
A.manyTill' Parser Text Char
A.anyChar Parser Text Text
"-}")
    Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
-> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    -- everything else a continuation and verbatim
    (\Text
x -> (Maybe (Section, Section)
forall a. Maybe a
Nothing, [Text
x])) (Text -> (Maybe (Section, Section), [Text]))
-> Parser Text Text -> Parser (Maybe (Section, Section), [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
A.takeText

-- | Parse assuming a hs block of code
parseHs :: [Text] -> [Block]
parseHs :: [Text] -> [Block]
parseHs [Text]
text = Fold (Either String (Maybe (Section, Section), [Text])) [Block]
-> [Either String (Maybe (Section, Section), [Text])] -> [Block]
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold (((Block, [Block])
 -> Either String (Maybe (Section, Section), [Text])
 -> (Block, [Block]))
-> (Block, [Block])
-> ((Block, [Block]) -> [Block])
-> Fold (Either String (Maybe (Section, Section), [Text])) [Block]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
L.Fold (Block, [Block])
-> Either String (Maybe (Section, Section), [Text])
-> (Block, [Block])
forall a.
(Block, [Block])
-> Either a (Maybe (Section, Section), [Text]) -> (Block, [Block])
step (Block, [Block])
forall a. (Block, [a])
begin (Block, [Block]) -> [Block]
done) ([Either String (Maybe (Section, Section), [Text])] -> [Block])
-> [Either String (Maybe (Section, Section), [Text])] -> [Block]
forall a b. (a -> b) -> a -> b
$ Parser (Maybe (Section, Section), [Text])
-> Text -> Either String (Maybe (Section, Section), [Text])
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser (Maybe (Section, Section), [Text])
normal (Text -> Either String (Maybe (Section, Section), [Text]))
-> [Text] -> [Either String (Maybe (Section, Section), [Text])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
text
  where
    begin :: (Block, [a])
begin = (Section -> [Text] -> Block
Block Section
Code [], [])
    done :: (Block, [Block]) -> [Block]
done (Block Section
_ [], [Block]
out) = [Block]
out
    done (Block
buff, [Block]
out) = [Block]
out [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<> [Block
buff]
    step :: (Block, [Block])
-> Either a (Maybe (Section, Section), [Text]) -> (Block, [Block])
step (Block, [Block])
x (Left a
_) = (Block, [Block])
x
    step (Block Section
s [Text]
ts, [Block]
out) (Right (Just (Section
this, Section
next), [Text]
ts')) =
      if
        | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts') -> (Section -> [Text] -> Block
Block Section
next [], [Block]
out)
        | Section
this Section -> Section -> Bool
forall a. Eq a => a -> a -> Bool
== Section
s Bool -> Bool -> Bool
&& Section
next Section -> Section -> Bool
forall a. Eq a => a -> a -> Bool
== Section
s -> (Section -> [Text] -> Block
Block Section
s ([Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts'), [Block]
out)
        | Section
this Section -> Section -> Bool
forall a. Eq a => a -> a -> Bool
/= Section
s -> (Section -> [Text] -> Block
Block Section
this [Text]
ts', [Block]
out [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<> [Section -> [Text] -> Block
Block Section
s [Text]
ts])
        | Bool
otherwise -> (Section -> [Text] -> Block
Block Section
next [], [Block]
out [Block] -> [Block] -> [Block]
forall a. Semigroup a => a -> a -> a
<> [Section -> [Text] -> Block
Block Section
s ([Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts')])
    step (Block Section
s [Text]
ts, [Block]
out) (Right (Maybe (Section, Section)
Nothing, [Text]
ts')) =
      if
        | [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts') -> (Section -> [Text] -> Block
Block Section
s [], [Block]
out)
        | Bool
otherwise -> (Section -> [Text] -> Block
Block Section
s ([Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts'), [Block]
out)

-- | Print a block of code to hs style
printHs :: [Block] -> [Text]
printHs :: [Block] -> [Text]
printHs [Block]
ss =
  [[Text]] -> [Text]
forall a. Monoid a => [a] -> a
mconcat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$
    ( \(Block Section
s [Text]
ts) ->
        case Section
s of
          Section
Code -> [Text]
ts
          Section
Comment -> [Text
"{-"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"-}"]
    )
      (Block -> [Text]) -> [Block] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block]
ss

-- | just in case there are ever other formats (YAML haskell anyone?)
data Format = Lhs | Hs

-- | Print
print :: Format -> [Block] -> [Text]
print :: Format -> [Block] -> [Text]
print Format
Lhs [Block]
f = [Block] -> [Text]
printLhs [Block]
f
print Format
Hs [Block]
f = [Block] -> [Text]
printHs [Block]
f

-- | Parse
parse :: Format -> [Text] -> [Block]
parse :: Format -> [Text] -> [Block]
parse Format
Lhs [Text]
f = [Text] -> [Block]
parseLhs [Text]
f
parse Format
Hs [Text]
f = [Text] -> [Block]
parseHs [Text]
f

-- | Convert a file from lhs to hs
lhs2hs :: FilePath -> IO ()
lhs2hs :: String -> IO ()
lhs2hs String
fp = do
  Text
t <- String -> IO Text
readFile (String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".lhs")
  String -> Text -> IO ()
writeFile (String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".hs") (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Format -> [Block] -> [Text]
print Format
Hs ([Block] -> [Text]) -> [Block] -> [Text]
forall a b. (a -> b) -> a -> b
$ Format -> [Text] -> [Block]
parse Format
Lhs ([Text] -> [Block]) -> [Text] -> [Block]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
lines Text
t

-- | Convert a file from hs to lhs
hs2lhs :: FilePath -> IO ()
hs2lhs :: String -> IO ()
hs2lhs String
fp = do
  Text
t <- String -> IO Text
readFile (String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".hs")
  String -> Text -> IO ()
writeFile (String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".lhs") (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Format -> [Block] -> [Text]
print Format
Lhs ([Block] -> [Text]) -> [Block] -> [Text]
forall a b. (a -> b) -> a -> b
$ Format -> [Text] -> [Block]
parse Format
Hs ([Text] -> [Block]) -> [Text] -> [Block]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
lines Text
t