{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Cassius
    ( -- * Datatypes
      Css
    , CssUrl
      -- * Type class
    , ToCss (..)
      -- * Rendering
    , renderCss
    , renderCssUrl
      -- * Parsing
    , cassius
    , cassiusFile
    , cassiusFileDebug
    , cassiusFileReload
      -- ** Mixims
    , cassiusMixin
    , Mixin
      -- * ToCss instances
      -- ** Color
    , Color (..)
    , colorRed
    , colorBlack
      -- ** Size
    , mkSize
    , AbsoluteUnit (..)
    , AbsoluteSize (..)
    , absoluteSize
    , EmSize (..)
    , ExSize (..)
    , PercentageSize (..)
    , percentageSize
    , PixelSize (..)
      -- * Internal
    , cassiusUsedIdentifiers
    ) where

import Text.Internal.Css
import Text.Shakespeare.Base
import Text.Shakespeare (VarType)
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax
import qualified Data.Text.Lazy as TL
import Text.Internal.CssCommon
import Text.Lucius (lucius)
import qualified Text.Lucius
import Text.IndentToBrace (i2b)

cassius :: QuasiQuoter
cassius :: QuasiQuoter
cassius = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
lucius (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
i2b }

cassiusFile :: FilePath -> Q Exp
cassiusFile :: String -> Q Exp
cassiusFile String
fp = do
    String
contents <- String -> Q String
readFileRecompileQ String
fp
    QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
cassius String
contents

cassiusFileDebug, cassiusFileReload :: FilePath -> Q Exp
cassiusFileDebug :: String -> Q Exp
cassiusFileDebug = Bool -> Q Exp -> Parser [TopLevel Unresolved] -> String -> Q Exp
cssFileDebug Bool
True [|Text.Lucius.parseTopLevels|] Parser [TopLevel Unresolved]
Text.Lucius.parseTopLevels
cassiusFileReload :: String -> Q Exp
cassiusFileReload = String -> Q Exp
cassiusFileDebug

-- | Determine which identifiers are used by the given template, useful for
-- creating systems like yesod devel.
cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
cassiusUsedIdentifiers :: String -> [(Deref, VarType)]
cassiusUsedIdentifiers = Bool
-> Parser [TopLevel Unresolved] -> String -> [(Deref, VarType)]
cssUsedIdentifiers Bool
True Parser [TopLevel Unresolved]
Text.Lucius.parseTopLevels

-- | Create a mixin with Cassius syntax.
--
-- Since 2.0.3
cassiusMixin :: QuasiQuoter
cassiusMixin :: QuasiQuoter
cassiusMixin = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = QuasiQuoter -> String -> Q Exp
quoteExp QuasiQuoter
Text.Lucius.luciusMixin (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
i2bMixin
    }

i2bMixin :: String -> String
i2bMixin :: String -> String
i2bMixin String
s' =
    Text -> String
TL.unpack
        (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
stripEnd Text
"}"
        (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
stripFront Text
"mixin {"
        (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.strip
        (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
TL.pack
        (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
i2b
        (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
"mixin" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s')
  where
    stripFront :: Text -> Text -> Text
stripFront Text
x Text
y =
        case Text -> Text -> Maybe Text
TL.stripPrefix Text
x Text
y of
            Maybe Text
Nothing -> Text
y
            Just Text
z -> Text
z
    stripEnd :: Text -> Text -> Text
stripEnd Text
x Text
y =
        case Text -> Text -> Maybe Text
TL.stripSuffix Text
x Text
y of
            Maybe Text
Nothing -> Text
y
            Just Text
z -> Text
z