{-# LANGUAGE CPP #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Markdown.Unlit (
  run
, unlit
, Selector (..)
, parseSelector
, CodeBlock (..)
, parse
#ifdef TEST
, parseReorderingKey
, parseClasses
#endif
) where

import           Prelude ()
import           Prelude.Compat
import           Control.Arrow
import           Data.Char
import           Data.List.Compat
import           Data.Maybe
import           Data.String
import           System.Environment
import           System.Exit
import           System.IO
import           Text.Read

fenceChars :: [Char]
fenceChars :: String
fenceChars = [Char
'`', Char
'~']

fences :: [String]
fences :: [String]
fences = (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
3) String
fenceChars

-- | Program entry point.
run :: [String] -> IO ()
run :: [String] -> IO ()
run [String]
args =
  -- GHC calls unlit like so:
  --
  -- > unlit [args] -h label Foo.lhs /tmp/somefile
  --
  -- [args] are custom arguments provided with -optL
  --
  -- The label is meant to be used in line pragmas, like so:
  --
  -- #line 1 "label"
  --
  case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-h") [String]
args of
    ([String] -> Selector
mkSelector -> Selector
selector, String
"-h" : [String]
files) -> case [String]
files of
      [String
src, String
cur, String
dst] -> do
        String -> IO String
readFileUtf8 String
cur IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> IO ()
writeFileUtf8 String
dst (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Selector -> String -> String
unlit String
src Selector
selector
      [String
src] -> do
        String -> IO String
readFileUtf8 String
src IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> String -> IO ()
writeUtf8 Handle
stdout (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Selector -> String -> String
unlit String
src Selector
selector
      [String]
_ -> IO ()
usage
    ([String], [String])
_ -> IO ()
usage
    where
      usage :: IO ()
      usage :: IO ()
usage = do
        String
name <- IO String
getProgName
        Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"usage: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [selector] -h SRC CUR DST")
        IO ()
forall a. IO a
exitFailure

      mkSelector :: [String] -> Selector
      mkSelector :: [String] -> Selector
mkSelector = Selector -> Maybe Selector -> Selector
forall a. a -> Maybe a -> a
fromMaybe (Selector
"haskell" Selector -> Selector -> Selector
:&: Selector -> Selector
Not Selector
"ignore") (Maybe Selector -> Selector)
-> ([String] -> Maybe Selector) -> [String] -> Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Selector
parseSelector (String -> Maybe Selector)
-> ([String] -> String) -> [String] -> Maybe Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords

      readFileUtf8 :: FilePath -> IO String
      readFileUtf8 :: String -> IO String
readFileUtf8 String
name = String -> IOMode -> IO Handle
openFile String
name IOMode
ReadMode IO Handle -> (Handle -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Handle
handle -> Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
utf8 IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO String
hGetContents Handle
handle

      writeFileUtf8 :: FilePath -> String -> IO ()
      writeFileUtf8 :: String -> String -> IO ()
writeFileUtf8 String
name String
str = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
name IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle
handle -> Handle -> String -> IO ()
writeUtf8 Handle
handle String
str

      writeUtf8 :: Handle -> String -> IO ()
      writeUtf8 :: Handle -> String -> IO ()
writeUtf8 Handle
handle String
str = Handle -> TextEncoding -> IO ()
hSetEncoding Handle
handle TextEncoding
utf8 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> String -> IO ()
hPutStr Handle
handle String
str

unlit :: FilePath -> Selector -> String -> String
unlit :: String -> Selector -> String -> String
unlit String
src Selector
selector = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeBlock -> [String]) -> [CodeBlock] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CodeBlock -> [String]
formatCodeBlock ([CodeBlock] -> [String])
-> (String -> [CodeBlock]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CodeBlock] -> [CodeBlock]
sortCodeBlocks ([CodeBlock] -> [CodeBlock])
-> (String -> [CodeBlock]) -> String -> [CodeBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeBlock -> Bool) -> [CodeBlock] -> [CodeBlock]
forall a. (a -> Bool) -> [a] -> [a]
filter (Selector -> [String] -> Bool
toPredicate Selector
selector ([String] -> Bool) -> (CodeBlock -> [String]) -> CodeBlock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeBlock -> [String]
codeBlockClasses) ([CodeBlock] -> [CodeBlock])
-> (String -> [CodeBlock]) -> String -> [CodeBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [CodeBlock]
parse
  where
    formatCodeBlock :: CodeBlock -> [String]
    formatCodeBlock :: CodeBlock -> [String]
formatCodeBlock CodeBlock
cb = (String
"#line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (CodeBlock -> Int
codeBlockStartLine CodeBlock
cb) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
src) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: CodeBlock -> [String]
codeBlockContent CodeBlock
cb

    sortCodeBlocks :: [CodeBlock] -> [CodeBlock]
    sortCodeBlocks :: [CodeBlock] -> [CodeBlock]
sortCodeBlocks = ((CodeBlock, (ReorderingKey, DeclarationOrder)) -> CodeBlock)
-> [(CodeBlock, (ReorderingKey, DeclarationOrder))] -> [CodeBlock]
forall a b. (a -> b) -> [a] -> [b]
map (CodeBlock, (ReorderingKey, DeclarationOrder)) -> CodeBlock
forall a b. (a, b) -> a
fst ([(CodeBlock, (ReorderingKey, DeclarationOrder))] -> [CodeBlock])
-> ([CodeBlock]
    -> [(CodeBlock, (ReorderingKey, DeclarationOrder))])
-> [CodeBlock]
-> [CodeBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CodeBlock, (ReorderingKey, DeclarationOrder))
 -> (ReorderingKey, DeclarationOrder))
-> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
-> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (CodeBlock, (ReorderingKey, DeclarationOrder))
-> (ReorderingKey, DeclarationOrder)
forall a b. (a, b) -> b
snd ([(CodeBlock, (ReorderingKey, DeclarationOrder))]
 -> [(CodeBlock, (ReorderingKey, DeclarationOrder))])
-> ([CodeBlock]
    -> [(CodeBlock, (ReorderingKey, DeclarationOrder))])
-> [CodeBlock]
-> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CodeBlock] -> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
addSortKey
      where
        addSortKey :: [CodeBlock] -> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
        addSortKey :: [CodeBlock] -> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
addSortKey = (DeclarationOrder
 -> CodeBlock -> (CodeBlock, (ReorderingKey, DeclarationOrder)))
-> [DeclarationOrder]
-> [CodeBlock]
-> [(CodeBlock, (ReorderingKey, DeclarationOrder))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((CodeBlock -> CodeBlock
forall a. a -> a
id (CodeBlock -> CodeBlock)
-> (CodeBlock -> (ReorderingKey, DeclarationOrder))
-> CodeBlock
-> (CodeBlock, (ReorderingKey, DeclarationOrder))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&&) ((CodeBlock -> (ReorderingKey, DeclarationOrder))
 -> CodeBlock -> (CodeBlock, (ReorderingKey, DeclarationOrder)))
-> (DeclarationOrder
    -> CodeBlock -> (ReorderingKey, DeclarationOrder))
-> DeclarationOrder
-> CodeBlock
-> (CodeBlock, (ReorderingKey, DeclarationOrder))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeclarationOrder -> CodeBlock -> (ReorderingKey, DeclarationOrder)
forall a. a -> CodeBlock -> (ReorderingKey, a)
sortKey) [DeclarationOrder
0..]

        sortKey :: a -> CodeBlock -> (ReorderingKey, a)
        sortKey :: forall a. a -> CodeBlock -> (ReorderingKey, a)
sortKey a
n CodeBlock
code = (CodeBlock -> ReorderingKey
reorderingKey CodeBlock
code, a
n)

    toPredicate :: Selector -> [String] -> Bool
    toPredicate :: Selector -> [String] -> Bool
toPredicate = Selector -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Selector -> t String -> Bool
go
      where
        go :: Selector -> t String -> Bool
go Selector
s = case Selector
s of
          Class String
c -> String -> t String -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
c
          Not Selector
p   -> Bool -> Bool
not (Bool -> Bool) -> (t String -> Bool) -> t String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> t String -> Bool
go Selector
p
          Selector
a :&: Selector
b -> Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (t String -> Bool) -> t String -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> t String -> Bool
go Selector
a (t String -> Bool -> Bool)
-> (t String -> Bool) -> t String -> Bool
forall a b.
(t String -> a -> b) -> (t String -> a) -> t String -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> t String -> Bool
go Selector
b
          Selector
a :|: Selector
b -> Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool)
-> (t String -> Bool) -> t String -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Selector -> t String -> Bool
go Selector
a (t String -> Bool -> Bool)
-> (t String -> Bool) -> t String -> Bool
forall a b.
(t String -> a -> b) -> (t String -> a) -> t String -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Selector -> t String -> Bool
go Selector
b

newtype DeclarationOrder = DeclarationOrder Int
  deriving newtype (DeclarationOrder -> DeclarationOrder -> Bool
(DeclarationOrder -> DeclarationOrder -> Bool)
-> (DeclarationOrder -> DeclarationOrder -> Bool)
-> Eq DeclarationOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclarationOrder -> DeclarationOrder -> Bool
== :: DeclarationOrder -> DeclarationOrder -> Bool
$c/= :: DeclarationOrder -> DeclarationOrder -> Bool
/= :: DeclarationOrder -> DeclarationOrder -> Bool
Eq, Eq DeclarationOrder
Eq DeclarationOrder =>
(DeclarationOrder -> DeclarationOrder -> Ordering)
-> (DeclarationOrder -> DeclarationOrder -> Bool)
-> (DeclarationOrder -> DeclarationOrder -> Bool)
-> (DeclarationOrder -> DeclarationOrder -> Bool)
-> (DeclarationOrder -> DeclarationOrder -> Bool)
-> (DeclarationOrder -> DeclarationOrder -> DeclarationOrder)
-> (DeclarationOrder -> DeclarationOrder -> DeclarationOrder)
-> Ord DeclarationOrder
DeclarationOrder -> DeclarationOrder -> Bool
DeclarationOrder -> DeclarationOrder -> Ordering
DeclarationOrder -> DeclarationOrder -> DeclarationOrder
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
$ccompare :: DeclarationOrder -> DeclarationOrder -> Ordering
compare :: DeclarationOrder -> DeclarationOrder -> Ordering
$c< :: DeclarationOrder -> DeclarationOrder -> Bool
< :: DeclarationOrder -> DeclarationOrder -> Bool
$c<= :: DeclarationOrder -> DeclarationOrder -> Bool
<= :: DeclarationOrder -> DeclarationOrder -> Bool
$c> :: DeclarationOrder -> DeclarationOrder -> Bool
> :: DeclarationOrder -> DeclarationOrder -> Bool
$c>= :: DeclarationOrder -> DeclarationOrder -> Bool
>= :: DeclarationOrder -> DeclarationOrder -> Bool
$cmax :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
max :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$cmin :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
min :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
Ord, Int -> DeclarationOrder
DeclarationOrder -> Int
DeclarationOrder -> [DeclarationOrder]
DeclarationOrder -> DeclarationOrder
DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
DeclarationOrder
-> DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
(DeclarationOrder -> DeclarationOrder)
-> (DeclarationOrder -> DeclarationOrder)
-> (Int -> DeclarationOrder)
-> (DeclarationOrder -> Int)
-> (DeclarationOrder -> [DeclarationOrder])
-> (DeclarationOrder -> DeclarationOrder -> [DeclarationOrder])
-> (DeclarationOrder -> DeclarationOrder -> [DeclarationOrder])
-> (DeclarationOrder
    -> DeclarationOrder -> DeclarationOrder -> [DeclarationOrder])
-> Enum DeclarationOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DeclarationOrder -> DeclarationOrder
succ :: DeclarationOrder -> DeclarationOrder
$cpred :: DeclarationOrder -> DeclarationOrder
pred :: DeclarationOrder -> DeclarationOrder
$ctoEnum :: Int -> DeclarationOrder
toEnum :: Int -> DeclarationOrder
$cfromEnum :: DeclarationOrder -> Int
fromEnum :: DeclarationOrder -> Int
$cenumFrom :: DeclarationOrder -> [DeclarationOrder]
enumFrom :: DeclarationOrder -> [DeclarationOrder]
$cenumFromThen :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
enumFromThen :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
$cenumFromTo :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
enumFromTo :: DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
$cenumFromThenTo :: DeclarationOrder
-> DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
enumFromThenTo :: DeclarationOrder
-> DeclarationOrder -> DeclarationOrder -> [DeclarationOrder]
Enum, Integer -> DeclarationOrder
DeclarationOrder -> DeclarationOrder
DeclarationOrder -> DeclarationOrder -> DeclarationOrder
(DeclarationOrder -> DeclarationOrder -> DeclarationOrder)
-> (DeclarationOrder -> DeclarationOrder -> DeclarationOrder)
-> (DeclarationOrder -> DeclarationOrder -> DeclarationOrder)
-> (DeclarationOrder -> DeclarationOrder)
-> (DeclarationOrder -> DeclarationOrder)
-> (DeclarationOrder -> DeclarationOrder)
-> (Integer -> DeclarationOrder)
-> Num DeclarationOrder
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
+ :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$c- :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
- :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$c* :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
* :: DeclarationOrder -> DeclarationOrder -> DeclarationOrder
$cnegate :: DeclarationOrder -> DeclarationOrder
negate :: DeclarationOrder -> DeclarationOrder
$cabs :: DeclarationOrder -> DeclarationOrder
abs :: DeclarationOrder -> DeclarationOrder
$csignum :: DeclarationOrder -> DeclarationOrder
signum :: DeclarationOrder -> DeclarationOrder
$cfromInteger :: Integer -> DeclarationOrder
fromInteger :: Integer -> DeclarationOrder
Num)

newtype ReorderingKey = ReorderingKey Int
  deriving newtype (ReorderingKey -> ReorderingKey -> Bool
(ReorderingKey -> ReorderingKey -> Bool)
-> (ReorderingKey -> ReorderingKey -> Bool) -> Eq ReorderingKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReorderingKey -> ReorderingKey -> Bool
== :: ReorderingKey -> ReorderingKey -> Bool
$c/= :: ReorderingKey -> ReorderingKey -> Bool
/= :: ReorderingKey -> ReorderingKey -> Bool
Eq, Int -> ReorderingKey -> String -> String
[ReorderingKey] -> String -> String
ReorderingKey -> String
(Int -> ReorderingKey -> String -> String)
-> (ReorderingKey -> String)
-> ([ReorderingKey] -> String -> String)
-> Show ReorderingKey
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ReorderingKey -> String -> String
showsPrec :: Int -> ReorderingKey -> String -> String
$cshow :: ReorderingKey -> String
show :: ReorderingKey -> String
$cshowList :: [ReorderingKey] -> String -> String
showList :: [ReorderingKey] -> String -> String
Show, ReadPrec [ReorderingKey]
ReadPrec ReorderingKey
Int -> ReadS ReorderingKey
ReadS [ReorderingKey]
(Int -> ReadS ReorderingKey)
-> ReadS [ReorderingKey]
-> ReadPrec ReorderingKey
-> ReadPrec [ReorderingKey]
-> Read ReorderingKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ReorderingKey
readsPrec :: Int -> ReadS ReorderingKey
$creadList :: ReadS [ReorderingKey]
readList :: ReadS [ReorderingKey]
$creadPrec :: ReadPrec ReorderingKey
readPrec :: ReadPrec ReorderingKey
$creadListPrec :: ReadPrec [ReorderingKey]
readListPrec :: ReadPrec [ReorderingKey]
Read, Eq ReorderingKey
Eq ReorderingKey =>
(ReorderingKey -> ReorderingKey -> Ordering)
-> (ReorderingKey -> ReorderingKey -> Bool)
-> (ReorderingKey -> ReorderingKey -> Bool)
-> (ReorderingKey -> ReorderingKey -> Bool)
-> (ReorderingKey -> ReorderingKey -> Bool)
-> (ReorderingKey -> ReorderingKey -> ReorderingKey)
-> (ReorderingKey -> ReorderingKey -> ReorderingKey)
-> Ord ReorderingKey
ReorderingKey -> ReorderingKey -> Bool
ReorderingKey -> ReorderingKey -> Ordering
ReorderingKey -> ReorderingKey -> ReorderingKey
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
$ccompare :: ReorderingKey -> ReorderingKey -> Ordering
compare :: ReorderingKey -> ReorderingKey -> Ordering
$c< :: ReorderingKey -> ReorderingKey -> Bool
< :: ReorderingKey -> ReorderingKey -> Bool
$c<= :: ReorderingKey -> ReorderingKey -> Bool
<= :: ReorderingKey -> ReorderingKey -> Bool
$c> :: ReorderingKey -> ReorderingKey -> Bool
> :: ReorderingKey -> ReorderingKey -> Bool
$c>= :: ReorderingKey -> ReorderingKey -> Bool
>= :: ReorderingKey -> ReorderingKey -> Bool
$cmax :: ReorderingKey -> ReorderingKey -> ReorderingKey
max :: ReorderingKey -> ReorderingKey -> ReorderingKey
$cmin :: ReorderingKey -> ReorderingKey -> ReorderingKey
min :: ReorderingKey -> ReorderingKey -> ReorderingKey
Ord, ReorderingKey
ReorderingKey -> ReorderingKey -> Bounded ReorderingKey
forall a. a -> a -> Bounded a
$cminBound :: ReorderingKey
minBound :: ReorderingKey
$cmaxBound :: ReorderingKey
maxBound :: ReorderingKey
Bounded, Integer -> ReorderingKey
ReorderingKey -> ReorderingKey
ReorderingKey -> ReorderingKey -> ReorderingKey
(ReorderingKey -> ReorderingKey -> ReorderingKey)
-> (ReorderingKey -> ReorderingKey -> ReorderingKey)
-> (ReorderingKey -> ReorderingKey -> ReorderingKey)
-> (ReorderingKey -> ReorderingKey)
-> (ReorderingKey -> ReorderingKey)
-> (ReorderingKey -> ReorderingKey)
-> (Integer -> ReorderingKey)
-> Num ReorderingKey
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ReorderingKey -> ReorderingKey -> ReorderingKey
+ :: ReorderingKey -> ReorderingKey -> ReorderingKey
$c- :: ReorderingKey -> ReorderingKey -> ReorderingKey
- :: ReorderingKey -> ReorderingKey -> ReorderingKey
$c* :: ReorderingKey -> ReorderingKey -> ReorderingKey
* :: ReorderingKey -> ReorderingKey -> ReorderingKey
$cnegate :: ReorderingKey -> ReorderingKey
negate :: ReorderingKey -> ReorderingKey
$cabs :: ReorderingKey -> ReorderingKey
abs :: ReorderingKey -> ReorderingKey
$csignum :: ReorderingKey -> ReorderingKey
signum :: ReorderingKey -> ReorderingKey
$cfromInteger :: Integer -> ReorderingKey
fromInteger :: Integer -> ReorderingKey
Num)

reorderingKey :: CodeBlock -> ReorderingKey
reorderingKey :: CodeBlock -> ReorderingKey
reorderingKey = [String] -> ReorderingKey
parseReorderingKey ([String] -> ReorderingKey)
-> (CodeBlock -> [String]) -> CodeBlock -> ReorderingKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeBlock -> [String]
codeBlockClasses

parseReorderingKey :: [String] -> ReorderingKey
parseReorderingKey :: [String] -> ReorderingKey
parseReorderingKey = [String] -> ReorderingKey
go
  where
    go :: [String] -> ReorderingKey
    go :: [String] -> ReorderingKey
go = \ case
      [] -> ReorderingKey
0
      String
"top" : [String]
_ -> ReorderingKey
forall a. Bounded a => a
minBound
      (Char
't' : Char
'o' : Char
'p' : Char
':' : (String -> Maybe ReorderingKey
forall a. Read a => String -> Maybe a
readMaybe -> Just ReorderingKey
n)) : [String]
_ -> ReorderingKey
forall a. Bounded a => a
minBound ReorderingKey -> ReorderingKey -> ReorderingKey
forall a. Num a => a -> a -> a
+ ReorderingKey
n
      String
_ : [String]
classes -> [String] -> ReorderingKey
go [String]
classes

infixr 3 :&:
infixr 2 :|:

data Selector
  = Class String
  | Not Selector
  | Selector :&: Selector
  | Selector :|: Selector
  deriving (Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
/= :: Selector -> Selector -> Bool
Eq, Int -> Selector -> String -> String
[Selector] -> String -> String
Selector -> String
(Int -> Selector -> String -> String)
-> (Selector -> String)
-> ([Selector] -> String -> String)
-> Show Selector
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Selector -> String -> String
showsPrec :: Int -> Selector -> String -> String
$cshow :: Selector -> String
show :: Selector -> String
$cshowList :: [Selector] -> String -> String
showList :: [Selector] -> String -> String
Show)

parseSelector :: String -> Maybe Selector
parseSelector :: String -> Maybe Selector
parseSelector String
input = case String -> [String]
words String
input of
  [] -> Maybe Selector
forall a. Maybe a
Nothing
  [String]
xs -> (Selector -> Maybe Selector
forall a. a -> Maybe a
Just (Selector -> Maybe Selector)
-> ([String] -> Selector) -> [String] -> Maybe Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Selector -> Selector -> Selector) -> [Selector] -> Selector
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Selector -> Selector -> Selector
(:|:) ([Selector] -> Selector)
-> ([String] -> [Selector]) -> [String] -> Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Selector) -> [String] -> [Selector]
forall a b. (a -> b) -> [a] -> [b]
map String -> Selector
parseAnds) [String]
xs
  where
    parseAnds :: String -> Selector
parseAnds = (Selector -> Selector -> Selector) -> [Selector] -> Selector
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Selector -> Selector -> Selector
(:&:) ([Selector] -> Selector)
-> (String -> [Selector]) -> String -> Selector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Selector) -> [String] -> [Selector]
forall a b. (a -> b) -> [a] -> [b]
map String -> Selector
parseClass ([String] -> [Selector])
-> (String -> [String]) -> String -> [Selector]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> [String]
split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+')

    parseClass :: String -> Selector
parseClass String
c = case String
c of
      Char
'!':String
xs -> Selector -> Selector
Not (String -> Selector
Class String
xs)
      String
_      -> String -> Selector
Class String
c

    -- a copy from https://github.com/sol/string
    split :: (Char -> Bool) -> String -> [String]
    split :: (Char -> Bool) -> String -> [String]
split Char -> Bool
p = String -> [String]
go
      where
        go :: String -> [String]
go String
xs = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
p String
xs of
          (String
ys, [])   -> [String
ys]
          (String
ys, Char
_:String
zs) -> String
ys String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
go String
zs

instance IsString Selector where
  fromString :: String -> Selector
fromString = String -> Selector
Class

data CodeBlock = CodeBlock {
  CodeBlock -> [String]
codeBlockClasses   :: [String]
, CodeBlock -> [String]
codeBlockContent   :: [String]
, CodeBlock -> Int
codeBlockStartLine :: Int
} deriving (CodeBlock -> CodeBlock -> Bool
(CodeBlock -> CodeBlock -> Bool)
-> (CodeBlock -> CodeBlock -> Bool) -> Eq CodeBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodeBlock -> CodeBlock -> Bool
== :: CodeBlock -> CodeBlock -> Bool
$c/= :: CodeBlock -> CodeBlock -> Bool
/= :: CodeBlock -> CodeBlock -> Bool
Eq, Int -> CodeBlock -> String -> String
[CodeBlock] -> String -> String
CodeBlock -> String
(Int -> CodeBlock -> String -> String)
-> (CodeBlock -> String)
-> ([CodeBlock] -> String -> String)
-> Show CodeBlock
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CodeBlock -> String -> String
showsPrec :: Int -> CodeBlock -> String -> String
$cshow :: CodeBlock -> String
show :: CodeBlock -> String
$cshowList :: [CodeBlock] -> String -> String
showList :: [CodeBlock] -> String -> String
Show)

type Line = (Int, String)

parse :: String -> [CodeBlock]
parse :: String -> [CodeBlock]
parse = [Line] -> [CodeBlock]
go ([Line] -> [CodeBlock]) -> ReadS Int -> String -> [CodeBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [String] -> [Line]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
2..] ([String] -> [Line]) -> (String -> [String]) -> ReadS Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  where
    go :: [Line] -> [CodeBlock]
    go :: [Line] -> [CodeBlock]
go [Line]
xs = case (Line -> Bool) -> [Line] -> ([Line], [Line])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Line -> Bool
isFence [Line]
xs of
      ([Line]
_, [])   -> []
      ([Line]
_, Line
y:[Line]
ys) -> case Line -> [Line] -> (CodeBlock, [Line])
takeCB Line
y [Line]
ys of
        (CodeBlock
cb, [Line]
rest) -> CodeBlock
cb CodeBlock -> [CodeBlock] -> [CodeBlock]
forall a. a -> [a] -> [a]
: [Line] -> [CodeBlock]
go [Line]
rest

    takeCB :: Line -> [Line] -> (CodeBlock, [Line])
    takeCB :: Line -> [Line] -> (CodeBlock, [Line])
takeCB (Int
n, String
fence) [Line]
xs =
      let indent :: Int
indent = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isSpace (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
fence
      in case (Line -> Bool) -> [Line] -> ([Line], [Line])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Line -> Bool
isFence [Line]
xs of
        ([Line]
cb, [Line]
rest) -> ([String] -> [String] -> Int -> CodeBlock
CodeBlock (String -> [String]
parseClasses String
fence) ((Line -> String) -> [Line] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
indent (String -> String) -> (Line -> String) -> Line -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> String
forall a b. (a, b) -> b
snd) [Line]
cb) Int
n, Int -> [Line] -> [Line]
forall a. Int -> [a] -> [a]
drop Int
1 [Line]
rest)

    isFence :: Line -> Bool
    isFence :: Line -> Bool
isFence = String -> Bool
p (String -> Bool) -> (Line -> String) -> Line -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (Line -> String) -> Line -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> String
forall a b. (a, b) -> b
snd
      where
        p :: String -> Bool
        p :: String -> Bool
p String
line = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line) [String]
fences

parseClasses :: String -> [String]
parseClasses :: String -> [String]
parseClasses String
xs = String -> [String]
words (String -> [String]) -> (String -> String) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> String -> String
replace Char
'.' Char
' ' (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
fenceChars) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
xs of
  Char
'{':String
ys -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') String
ys
  String
ys -> String
ys

replace :: Char -> Char -> String -> String
replace :: Char -> Char -> String -> String
replace Char
x Char
sub = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f
  where
    f :: Char -> Char
f Char
y | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
y    = Char
sub
        | Bool
otherwise = Char
y